(in-package :lilu-apropos)

;;;
;;; interactive apropos
;;;

(defparameter *asdf-options*
  '((:system-name-regex :regex "")
    (:loaded-p (member :any :yes :no) :any)
    (:description-p (member :any :yes :no) :any)
    (:version-p (member :any :yes :no) :any)
    (:author-p (member :any :yes :no) :any)
    (:homepage-p (member :any :yes :no) :any)
    (:license-p (member :any :yes :no) :any)))

(defclass asdf-iapropos (iapropos)
  ()
  (:default-initargs
   :options *asdf-options*
   :remove-duplicate-p nil
   :sorting-symbol-p nil
   :obj->string-fn #'asdf:component-name
   :match-object-fn #'%asdf-iapropos-match-system-p))

(defgeneric asdf-iapropos-matched-systems (asdf-iapropos)
  (:documentation "Return the list of symbols that match the specified criteria")
  (:method  ((iapropos asdf-iapropos))
    (with-slots (cached-matched-objects) iapropos
      cached-matched-objects)))

(defun asdf-iapropos-set-option-values (iapropos &rest args
                                               &key reset-p system-name-regex loaded-p description-p
                                                 version-p author-p homepage-p license-p)
  (declare (ignore system-name-regex loaded-p description-p version-p
                   author-p homepage-p license-p))
  (apply #'iapropos-set-option-values iapropos :reset-p reset-p args))

(defmethod iapropos-update-search ((iapropos asdf-iapropos) changes)
  (iapropos-maching-objects iapropos
                            (asdf:registered-systems)
                            :fn #'asdf:find-system))

(defun %asdf-iapropos-match-system-p (iapropos system)
  (with-slots (cached-regexp-scanners option-values) iapropos
    (and
     system
     (car (asdf:system-registered-p system))
     (when-option-regex (:system-name-regex cached-regexp-scanners)
       (cl-ppcre:scan scanner (asdf:component-name system)))
     (when-option-yes/no (:loaded-p option-values)
       (asdf:component-loaded-p system))
     (when-option-yes/no (:description-p option-values)
       (asdf:system-description system))
     (when-option-yes/no (:version-p option-values)
       (asdf:component-version system))
     (when-option-yes/no (:author-p option-values)
       (asdf:system-author system))
     (when-option-yes/no (:homepage-p option-values)
       (asdf:system-homepage system))
     (when-option-yes/no (:license-p option-values)
       (asdf:system-license system)))))

(defmethod iapropos-describe-object ((iapropos asdf-iapropos) system)
  (list :name (asdf:component-name system)
        :long-name (or (asdf:system-long-name system) :missing)
        :version (or (asdf:component-version system) :missing)
        :loaded-p (asdf:component-loaded-p system)
        :author (or (asdf:system-author system) :missing)
        :homepage (or (asdf:system-homepage system) :missing)
        :license (or (asdf:system-license system) :missing)
        :location (let ((loc (asdf:system-source-file system)))
                    (if loc (cons :file loc) :missing))
        :description (or (asdf:system-description system) :missing)
        :long-description (or (asdf:system-long-description system) :missing)))
